#+TITLE: The Seasoned Schemer Notes
#+SUBTITLE: Chapter 12
#+AUTHOR: Zelphir Kaltstahl
#+DATE: [2023-02-21 Di]
#+LANGUAGE: English
#+TAGS: Scheme, The Seasoned Schemer
#+CREATOR: Emacs
#+EXCLUDE_TAGS: noexport
#+OPTIONS: ^:{} H:10 toc:2
#+STARTUP: content indent align inlineimages hideblocks entitiesplain nologdone nologreschedule nologredeadline nologrefile

* Prerequisites

#+NAME: defatom
#+BEGIN_SRC scheme :noweb yes :results none :exports code :eval never-export
(define atom?
  (λ (x)
    (and (not (pair? x))
         (not (null? x)))))
#+end_src

In theory we could define other things as numbers, for example church numerals.

#+NAME: defonep
#+BEGIN_SRC scheme :noweb yes :results none :exports code :eval never-export
(define one?
  (λ (x)
    (= x 1)))
#+end_src

#+NAME: defpick
#+BEGIN_SRC scheme :noweb yes :results none :exports code :eval never-export
(define pick
  (λ (n lat)
    (cond
     [(one? n) (car lat)]
     [else
      (pick (- n 1) (cdr lat))])))
#+end_src

** Y-combinator

In the first book the Y-combinator was derived. It is again:

#+NAME: y-combinator-def
#+begin_src scheme :noweb yes :results none :exports code :eval never-export :language guile
(define Y
  (λ (proc)
    ((λ (f) (f f))
     (λ (f)
       (proc
        (λ (x) ((f f) x)))))))
#+end_src

** All prerequisites                                              :noexport:

#+NAME: prereq
#+BEGIN_SRC scheme :noweb yes :results none :exports none :eval never-export
<<defatom>>

<<defonep>>

<<defpick>>

<<y-combinator-def>>
#+END_SRC

* Chapter 12

** Recap of Y

*** Recursive ~length~ function using ~Y~

#+NAME: length-y
#+begin_src scheme :noweb yes :results none :exports none :eval never-export :language guile
<<y-combinator-def>>

(define length
  (Y (λ (length)
       (λ (lst)
         (cond
          [(null? lst) 0]
          [else
           (+ (length (cdr lst)) 1)])))))
#+end_src

The length function is injected as an argument. Thus the expression is not referring to itself, but only ever to its argument.

The inner part looks just like the usual recursive length function. It is using an argument (~length~) as the thing it calls in the recursive case though.

#+NAME: length-y-usage
#+begin_src scheme :noweb yes :results output replace drawer :wrap example :exports both :eval never-export :language guile
<<length-y>>

(simple-format #t "(length '(a b c d)) = ~a\n" (length '(a b c d)))
#+end_src

#+RESULTS: length-y-usage
#+begin_example
(length '(a b c d)) = 4
#+end_example

*** ~multirember~ (remove member multiple times) function using ~Y~

The argument of ~Y~ is always a lambda expression, which takes as argument the function to be called in the recursive case. That function itself returns a function, which takes the actual input. In this example that is a list of atoms.

#+NAME: multirember-y-def
#+begin_src scheme :noweb yes :results output replace drawer :wrap example :exports code :eval never-export :language guile
<<y-combinator-def>>

(define multirember
  (λ (a lat)
    ((Y (λ (mr)
          (λ (lat)
            (cond
             [(null? lat) '()]
             [(eq? a (car lat))
              (mr (cdr lat))]
             [else
              (cons (car lat)
                    (mr (cdr lat)))]))))
     lat)))
#+end_src

**** Usage

#+NAME: multirember-y-usage
#+begin_src scheme :noweb yes :results none :wrap example :exports code :eval never-export :language guile
(multirember 'a '(a b c a d))
#+end_src

**** Results

#+NAME: multirember-y-result
#+begin_src scheme :noweb yes :results output replace drawer :wrap example :exports results :eval never-export :language guile
<<multirember-y-def>>

(simple-format
 #t "~a\n"
 (multirember 'a '(a b c a d)))
#+end_src

#+RESULTS: multirember-y-result
#+begin_example
(b c d)
#+end_example

** Introduction of ~letrec~

~letrec~ offers a way to avoid using ~Y~ and possibly get a more easily understandable definition of recursive functions.

*** ~multirember~ (remove member multiple times) function using ~letrec~

The following definition of ~multirember~ makes use of ~letrec~ instead of ~Y~, because the definition of ~mr~ inside makes use of ~mr~ recursively itself. A normal ~let~ would not work here. The recursive ~mr~ is then returned and applied to ~lat~, a list of atoms. This chapter introduces ~letrec~.

#+NAME: multirember-letrec-def
#+begin_src scheme :noweb yes :results output replace drawer :wrap example :exports code :eval never-export :language guile
(define multirember
  (λ (a lat)
    ((letrec
         ([mr (λ (lat)
                (cond
                 [(null? lat) '()]
                 [(eq? a (car lat))
                  (mr (cdr lat))]
                 [else
                  (cons (car lat)
                        (mr (cdr lat)))]))])
       mr)
     lat)))
#+end_src

**** Usage

#+NAME: multirember-letrec-usage
#+begin_src scheme :noweb yes :results none :wrap example :exports code :eval never-export :language guile
(multirember 'a '(a b c a d))
#+end_src

**** Result

#+NAME: multirember-letrec-results
#+begin_src scheme :noweb yes :results output replace drawer :wrap example :exports results :eval never-export :language guile
<<multirember-letrec-def>>

(simple-format
 #t "~a\n"
 (multirember 'a '(a b c a d)))
#+end_src

#+RESULTS: multirember-letrec-results
#+begin_example
(b c d)
#+end_example

**** A more readable version

Using the following definition, one can avoid 1 wrapping of parentheses of the ~letrec~ expression and move it into the value part of the ~letrec~ expression:

#+NAME: multirember-letrec-def-2
#+begin_src scheme :noweb yes :results output replace drawer :wrap example :exports code :eval never-export :language guile
(define multirember
  (λ (a lat)
    (letrec
        ([mr (λ (lat)
               (cond
                [(null? lat) '()]
                [(eq? a (car lat))
                 (mr (cdr lat))]
                [else
                 (cons (car lat)
                       (mr (cdr lat)))]))])
      (mr lat))))
#+end_src

This seems a bit more readable to me.

** ~multirember~ with configurable ~test?~ predicate

We can use 1 layer of currying to make a "factory" of ~multirember~ functions, which know how to test for whether an element should be removed from a list.

#+NAME: multirember-letrec-with-pred
#+begin_src scheme :noweb yes :results output replace drawer :wrap example :exports code :eval never-export :language guile
(define make-multirember
  (λ (test?)
    (λ (a lat)
      (letrec
          ([mr (λ (lat)
                 (cond
                  [(null? lat) '()]
                  [(test? a (car lat))
                   (mr (cdr lat))]
                  [else
                   (cons (car lat)
                         (mr (cdr lat)))]))])
        (mr lat)))))
#+end_src

#+NAME: multirember-letrec-with-pred-usage
#+begin_src scheme :noweb yes :results output replace drawer :wrap example :exports both :eval never-export :language guile
(simple-format
 #t "~a\n"
 ((make-multirember =) 1 '(2 4 6 12 1 2)))
#+end_src

#+RESULTS: multirember-letrec-with-pred-usage
#+begin_example
(2 4 6 12 2)
#+end_example

** Set union implementation

*** First version

#+NAME: set-union-1
#+begin_src scheme :noweb yes :results output replace drawer :wrap example :exports both :eval never-export :language guile
(define member? member)

(define union
  (λ (set1 set2)
    (cond
     [(null? set1) set2]
     [(member? (car set1) set2)
      (union (cdr set1) set2)]
     [else
      (cons (car set1)
            (union (cdr set1) set2))])))

(simple-format
 #t "~a\n"
 (union '(a b c d) '(s b a e)))
#+end_src

#+RESULTS: set-union-1
#+begin_example
(c d s b a e)
#+end_example

*** Second version with captured ~set2~

The text has objections about the fact, that ~union~ is always called with 2 arguments, the 2 sets to build the union of, although ~set2~ never changes. It argues, that one can make the recursive calls simpler, by capturing ~set2~ outside of the recursive part.

#+NAME: set-union-2
#+begin_src scheme :noweb yes :results output replace drawer :wrap example :exports both :eval never-export :language guile
(define member? member)

(define union
  (λ (set1 set2)
    (letrec ([U
              (λ (set1°)
                (cond
                 [(null? set1°) set2]
                 [(member? (car set1°) set2)
                  (U (cdr set1°))]
                 [else
                  (cons (car set1°)
                        (U (cdr set1°)))]))])
      (U set1))))

(simple-format
 #t "~a\n"
 (union '(a b c d) '(s b a e)))
#+end_src

#+RESULTS: set-union-2
#+begin_example
(c d s b a e)
#+end_example

*** Third version with protected ~member?~

The text also notes, that ~union~ relies on ~member?~, which is implemented elsewhere. ~union~ serves as an example. ~member?~ or ~member~ is usually implemented in Scheme dialects, so it will not suddenly change. However, if it were a function, which were to change for example the order of its arguments, then we would have to adapt ~union~ and all other functions depending on ~member?~ as well. For this reason, the text argues for internalizing the definition of ~member?~ inside of ~union~.

#+NAME: set-union-3
#+begin_src scheme :noweb yes :results output replace drawer :wrap example :exports both :eval never-export :language guile
(define union
  (λ (set1 set2)
    (letrec ([U
              (λ (set1°)
                (cond
                 [(null? set1°) set2]
                 [(member? (car set1°) set2)
                  (U (cdr set1°))]
                 [else
                  (cons (car set1°)
                        (U (cdr set1°)))]))]
             [member?
              (λ (elem lst)
                (letrec ([M?
                          (λ (lst°)
                            (cond
                             [(null? lst°) #f]
                             [(eq? elem (car lst°)) #t]
                             [else (M? (cdr lst°))]))])
                  (M? lst)))])
      (U set1))))

(simple-format
 #t "~a\n"
 (union '(a b c d) '(s b a e)))
#+end_src

#+RESULTS: set-union-3
#+begin_example
(c d s b a e)
#+end_example

*** Fourth version

Maybe instead of defining a whole ~member?~ inside ~letrec~ one could make a minimalistic wrapper for the ~member~ function already defined in Scheme. This way we would not reimplement things which are already in our language:

#+NAME: set-union-4
#+begin_src scheme :noweb yes :results output replace drawer :wrap example :exports both :eval never-export :language guile
(define union
  (λ (set1 set2)
    (letrec ([U
              (λ (set1°)
                (cond
                 [(null? set1°) set2]
                 [(member? (car set1°) set2)
                  (U (cdr set1°))]
                 [else
                  (cons (car set1°)
                        (U (cdr set1°)))]))]
             [member?
              (λ (elem lst)
                (letrec ([M?
                          (λ (lst°)
                            (not (null? (member elem lst))))])
                  (M? lst)))])
      (U set1))))

(simple-format
 #t "~a\n"
 (union '(a b c d) '(s b a e)))
#+end_src

The book has a bootstrapping approach, so it opts to implement ~member?~ inside ~union~. A disadvantage of that is, that it cannot be separately unit-tested. Perhaps the philosophy there is, that encapsulation is more important than tests.
